Gigarom 1/Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso/FILES/HYP/C-D/DartmouthXCMDs.cpt/Dartmouth XCMDs Vol 1&2/card_4672.txt

Text File | 1989-02-26 | 19KB | 569 lines

-- card: 4672 from stack: in
-- bmap block id: 0
-- flags: 0000
-- background id: 3241
-- name: FileToField


-- part 1 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=79 top=300 right=322 bottom=179
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: FileToField
----- HyperTalk script -----
on mouseUp
  FileToField "card field 1"
  put the result into theResult
  put theResult
  if theResult is not "Cancel" then
    if word 1 of theResult is not "Error" then
      show card field 1
      set the visible of card button 2 to true
    end if
  end if
end mouseUp



-- part 2 (field)
-- low flags: 80
-- high flags: 2007
-- rect: left=265 top=33 right=296 bottom=486
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 20
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: FileToField Text


-- part 3 (button)
-- low flags: 80
-- high flags: A003
-- rect: left=284 top=268 right=290 bottom=458
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Empty and Hide this Field
----- HyperTalk script -----
on mouseUp
  set lockscreen to true
  put empty into card field 1
  hide card field 1
  set the visible of me to false
  set lockscreen to false
end mouseUp



-- part 6 (field)
-- low flags: 80
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 7 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=314 top=300 right=322 bottom=435
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show LSP Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field "Source" to not the visible of card field "Source"
  if the visible of card field "Source" is true then
    set the name of me to "Hide LSP Source"
  else set the name of me to "Show LSP Source"
end mouseUp



-- part contents for background part 16
----- text -----
FILETOFIELD XCMD version 1.2
Kevin Calhoun

The FileToField XCMD allows you to copy the contents of a text file into a HyperCard field.  You may choose the text file to copy from by selecting it from a standard file dialog box or by specifying its full pathname.

If the text file is too large (just under 30K is the practical limit for HyperCard fields), FileToField won't try to copy it into the field.  If this or any other error occurs, FileToField will return an error message as the result.  Word 1 of this message will be "Error".  If the text was copied successfully, FileToField returns the full pathname of the file as the result.

INVOKING FILETOFIELD
You may designate the field into which the text is to be copied in any way considered valid by HyperCard, by number, id, or name, with one exception:  you can't use the field's name if it is more than one word.  If you do use the field's name, don't put the field name in quotation marks.  Nested quotations confuse HyperCard.  (See the examples below.)

If you don't supply the pathname of the file to be copied from, FileToField will invoke SFGetFile, and the user can select the file from the dialog box.  If the user pushes the cancel buton of the dialog box, FileToField returns "Cancel" as the Result.

FileToField fieldDesignation,<full pathname of file>

examples--

FileToField("card field 1")                --these examples copy files chosen from the
FileToField("bkgnd field id 16")       --standard file dialog into the specified field
FileToField("card field Memorex")

FileToField "field 5","OldAchesAndPains:Good Stuff:Secrets"  --this copies the file
"Secrets" into background field 5.

REVISION HISTORY
7 March 1988: release of version 1.0
31 March 1988: release of version 1.1
  --better reporting of memory errors
  --more compact code
16 May 1988: release of version 1.2
  -- fixed bug that bombed MacPlus (switched from PBHOpen to FSOpen)

-- part contents for card part 6
----- text -----
UNIT FileToFieldUnit;
{ FileToField XCMD ©1988 by the Trustees of Dartmouth College. }
{ Written by John K. Calhoun, Courseware Development. }

{ Project contains: }
{ MacTraps }
{ DA Paslib }
{ ROM85Lib }
{ HFS }
{ XCMD Interface.p }
{ FileToFieldXCMD.p (this file ) }

INTERFACE
 USES
  HFS, XCmdIntf;

 TYPE
  Str31 = STRING[31];

 PROCEDURE main (paramPtr : XCmdPtr);

IMPLEMENTATION

{-----------------------------------------------------------------}

{ The following routines are from the file XCMDUtilities.p. }
{ Instead of including the entire XCMD utilities file, }
{ we add to our code only the ones we actually need. }
{ This trims the size of our XCMD resource. }

 PROCEDURE DoJsr (addr : ProcPtr);
 INLINE
  $205F, $4E90;

 FUNCTION EvalExpr (paramPtr : XCmdPtr;
         expr : Str255) : Handle;
 BEGIN
  WITH paramPtr^ DO
   BEGIN
    inArgs[1] := ORD(@expr);
    request := xreqEvalExpr;
    DoJsr(entryPoint);
    EvalExpr := Handle(outArgs[1]);
   END;
 END;

 PROCEDURE ZeroToPas (paramPtr : XCmdPtr;
         zeroStr : Ptr;
         VAR pasStr : Str255);
 BEGIN
  WITH paramPtr^ DO
   BEGIN
    inArgs[1] := ORD(zeroStr);
    inArgs[2] := ORD(@pasStr);
    request := xreqZeroToPas;
    DoJsr(entryPoint);
   END;
 END;

 FUNCTION StrToNum (paramPtr : XCmdPtr;
         str : Str31) : LongInt;
 BEGIN
  WITH paramPtr^ DO
   BEGIN
    inArgs[1] := ORD(@str);
    request := xreqStrToNum;
    DoJsr(entryPoint);
    StrToNum := outArgs[1];
   END;
 END;

 FUNCTION StringMatch (paramPtr : XCmdPtr;
         pattern : Str255;
         target : Ptr) : Ptr;
 BEGIN
  WITH paramPtr^ DO
   BEGIN
    inArgs[1] := ORD(@pattern);
    inArgs[2] := ORD(target);
    request := xreqStringMatch;
    DoJsr(entryPoint);
    StringMatch := Ptr(outArgs[1]);
   END;
 END;

 PROCEDURE SetFieldByID (paramPtr : XCmdPtr;
         cardFieldFlag : BOOLEAN;
         fieldID : INTEGER;
         fieldVal : Handle);
 BEGIN
  WITH paramPtr^ DO
   BEGIN
    inArgs[1] := ORD(cardFieldFlag);
    inArgs[2] := fieldID;
    inArgs[3] := ORD(fieldVal);
    request := xreqSetFieldByID;
    DoJsr(entryPoint);
   END;
 END;

 FUNCTION PasToZero (paramPtr : XCmdPtr;
         str : Str255) : Handle;
 BEGIN
  WITH paramPtr^ DO
   BEGIN
    inArgs[1] := ORD(@str);
    request := xreqPasToZero;
    DoJsr(entryPoint);
    PasToZero := Handle(outArgs[1]);
   END;
 END;

 FUNCTION NumToStr (paramPtr : XCmdPtr;
         num : LongInt) : Str31;
  VAR
   str : Str31;
 BEGIN
  WITH paramPtr^ DO
   BEGIN
    inArgs[1] := num;
    inArgs[2] := ORD(@str);
    request := xreqNumToStr;
    DoJsr(entryPoint);
    NumToStr := str;
   END;
 END;

{-----------------------------------------------------------------}

{ Our routines begin here. }

 FUNCTION BuildThePathname (fName : Str255;
         vRefNum : INTEGER) : Str255;
{ Given the "short name" and vRefNum of a file, returns the full pathname. }
{ This function is adapted from Steve Maller's FileName XFCN published in }
{ HyperTalk Programming by Dan Shafer, Howard W. Sams & Company, 1988, }
{ pp. 399-403. }
  VAR
   name, fullPathName : Str255;
   err : INTEGER;
   myWDPB : WDPBPtr;
   myCPB : CInfoPBPtr;
   myPB : HParmBlkPtr;

 BEGIN
  fullPathName := '';     { start with an empty pathname }
{ Allocate some memory in the heap for the parameter block. }
  myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec)));
  IF ord4(myCPB) > 0 THEN    { continue if mem allocation was OK }

   BEGIN
    myWDPB := WDPBPtr(myCPB);
    myPB := HParmBlkPtr(myCPB);
{ same pointer, different variations of the record -- see IM IV, p. 117 }
    name := '';     { start with an empty name for the volume }

    WITH myPB^ DO
     BEGIN
      ioNamePtr := @name;   { we want the volume name }
      ioCompletion := pointer(0);
      ioVRefNum := vRefNum;  { returned by SFGetFile }
      ioVolIndex := 0;  { use the vRefNum and name only to designate volume }
     END;
    err := PBHGetVInfo(myPB, FALSE);  { fill in the volume info }
    IF err = noErr THEN

     BEGIN
{ Now we need the Working Directory (WD) information because we're }
{ going to step backwards from the file through all of the folders until }
{ we reach the root directory. }
      WITH myWDPB^ DO
       BEGIN
        ioVRefNum := vRefNum;  { this got set to 0 above }
        ioWDProcID := 0;   { use the vRefNum }
        ioWDIndex := 0;     { we want all directories }
       END;
      err := PBGetWDInfo(myWDPB, FALSE);
      IF err = noErr THEN
       BEGIN
        WITH myCPB^ DO
         BEGIN
          ioFDirIndex := -1;   { use the ioDirID field only }
          ioDrDirID := myWDPB^.ioWDDirID;   { info returned above }
         END;
        err := PBGetCatInfo(myCPB, FALSE);
        IF err = noErr THEN
         BEGIN

{ Here starts the real work -- start to climb the tree by continually }
{ looking in the ioDrParID field for the next directory above until we fail... }
          myCPB^.ioDrDirID := myCPB^.ioDrParID;  { the first folder }
          fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fName);
          REPEAT
           myCPB^.ioDrDirID := myCPB^.ioDrParId;
           err := PBGetCatInfo(myCPB, FALSE);    { the next level }
{ Be careful of an error returned here -- it means the user chose a file on the }
{ desktop level of this volume.  If this is the case, just stop here and return }
{ "VolumeName:FileName"; otherwise loop until failure. }
           IF err = noErr THEN
            fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fullPathName);
          UNTIL err <> noErr;
         END;  { if PBGetCatInfo worked OK }
       END;  { if PBGetWDInfo worked OK }
     END;  { if PBHGetVInfo worked OK }
    DisposPtr(pointer(myCPB));
   END;  { if we had enough room for a new pointer }
  BuildThePathname := fullPathName;
 END;

 FUNCTION GetLocOfCardWindow (paramPtr : XCmdPtr) : point;
  VAR
   theResult : Handle;
   aString : Str255;
   theLoc : point;
 BEGIN
  theResult := EvalExpr(paramPtr, 'item 1 of the loc of card window');
{ get horizontal coordinate of the card window }
  ZeroToPas(paramPtr, theResult^, aString);  { turn it into a string }
  DisposHandle(theResult);  { throw away the handle HC allocated }
  theLoc.h := StrToNum(paramPtr, aString);
{ convert to a number and save it in theLoc }

  theResult := EvalExpr(paramPtr, 'item 2 of the loc of card window');
{ get vertical coordinate of the card window }
  ZeroToPas(paramPtr, theResult^, aString);  { turn it into a string }
  DisposHandle(theResult);  { throw away the handle HC allocated }
  theLoc.v := StrToNum(paramPtr, aString);
{ convert it to a number and save it in theLoc }
  GetLocOfCardWindow := theLoc;  { ...and return }
 END;

 PROCEDURE passReturnValue (paramPtr : XCMDPtr;
         theMsg : Str255); { set theResult }
 BEGIN
  paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
 END;

 PROCEDURE SetField (paramPtr : XCmdPtr;
         theStringPtr : Ptr;
         theTextHandle : handle);
  VAR
   whichField, theString : Str255;
   cardFieldFlag : BOOLEAN;
   matchPtr : Ptr;
   theResult : Handle;
   fieldID : INTEGER;

 BEGIN
{ get Pascal string that contains designation of field to be printed }
  ZeroToPas(paramPtr, theStringPtr, whichField);
{ get long name of this field to see if it's a card or bkgnd field }
  theResult := EvalExpr(paramPtr, CONCAT('the long name of ', whichField));
  IF (paramPtr^.result = noErr) THEN
   BEGIN
    MoveHHi(theResult);
    HLock(theResult);

{ see if this thing actually is an extant field }
{ if HC returns a long field name with the word 'card' in it, we'll assume it's real }
    matchPtr := StringMatch(paramPtr, 'card', theResult^);

    IF (matchPtr <> NIL) AND (paramPtr^.result = noErr) THEN  { this must be a field after all }
     BEGIN
{ check to see if name of field contains 'card field' -- so we can set the cardFieldFlag }
      matchPtr := StringMatch(paramPtr, 'card field', theResult^);
      cardFieldFlag := (matchPtr <> NIL);
{ free the space allocated by EvalExpr above }
      HUnlock(theResult);
      DisposHandle(theResult);

{ get the id of this field }
      theResult := EvalExpr(paramPtr, CONCAT('the id of ', whichField));
      IF (theResult <> NIL) AND (paramPtr^.result = noErr) THEN
       BEGIN
        MoveHHi(theResult);
        HLock(theResult);
{ convert it into a string, then into a number }
        ZeroToPas(paramPtr, theResult^, theString);
        fieldID := StrToNum(paramPtr, theString);
        HUnlock(theResult);
        DisposHandle(theResult);  { and free the memory allocated by EvalExpr }

        SetFieldByID(paramPtr, cardFieldFlag, fieldID, theTextHandle);
       END;
{ set the contents of the field to the contents of theTextHandle }
     END;
   END;
  IF GetHandleSize(theResult) <> 0 THEN
   BEGIN
    HUnlock(theResult);
    DisposHandle(theResult);
   END;
 END;

 PROCEDURE FileToField (paramPtr : XCmdPtr);
  VAR
   reply : SFReply;   { returned by SFGetFile }
   fileName : Str255;  { name of file to open }
   theVRefNum : INTEGER;  { ref num of volume (or directory) on which the file resides }
   theRefNum : INTEGER;  { refNum of file, for file manager calls }
   err : OSErr;  { save error codes for reporting trouble }
   logEOF : longint;   { length of file }
   theBufHndl : Handle;  { for copying contents of file into memory }
   zeroByte : INTEGER;  { for appending zero byte on the end of the text }
   zeroByteHndl : Handle;
   parameterCount : INTEGER;  { the number of parameters passed to us }
   didSFGet : BOOLEAN;

  PROCEDURE DoSFGet;
   VAR
    where : point;
    typeList : SFTypeList;
  BEGIN  { select text file to read using SFGetFile }

   SetPt(where, 82, 75); { tell SFGetFile where to put the dialog box }
   AddPt(GetLocOfCardWindow(paramPtr), where);  { align the dialog box }
                             { with current location of the card window }
   typeList[0] := 'TEXT'; { tell SFGetFile to display only text files }
   SFGetFile(where, '', NIL, 1, typeList, NIL, reply); { call SFGetFile }
  END;

  FUNCTION GetFileName : Str255;
           { return the name of the file to copy from }
   VAR
    temp : Str255;
  BEGIN
   IF parameterCount > 1 THEN  { second parameter, if present,  }
                            { contains full pathname of file to copy from }
    BEGIN
     ZeroToPas(paramPtr, paramPtr^.params[2]^, temp);
     didSFGet := FALSE;  { remember that we didn't call SFGet }
    END
   ELSE
    BEGIN          { if second parameter isn't present, call SFGet }
     doSFGet;
     IF reply.good = TRUE THEN
      temp := reply.fName  { return name of file user selected }
     ELSE
      temp := '';  { return empty file name if user pushed "Cancel" }
     didSFGet := TRUE;  { remember that we called SF }
    END;
   GetFileName := temp;
  END;

 BEGIN
  parameterCount := paramPtr^.paramCount;  { store the paramCount }
  IF parameterCount > 0 THEN  { check for parameters }

{ If user passes no parameters I return my version number as the result and quit. }
{ If the required params are present, we perform the XCMD's main function.}

   BEGIN
    fileName := GetFileName;  { get the name of the file to copy from }
    IF fileName <> '' THEN
{ continue only if we have a file name, otherwise pass "cancel" as the result }
     BEGIN
      IF didSFGet THEN  { we've got the vRefNum and the file name  }
       theVRefNum := reply.vRefNum
      ELSE   { we have the full pathname but not the vRefNum }
       theVRefNum := 0;  { tell FSOpen to use just the file name }
      err := FSOpen(fileName, theVRefNum, theRefNum);
      IF err = noErr THEN { continue only if file could be opened }
       BEGIN
        err := GetEOF(theRefNum, logEOF);  { find out how big the file is }
        IF err = noErr THEN
         IF logEOF < 29990 THEN  { continue only if file isn't too big to read into a HC field }
{ 29990 bytes is my experimental value for the maximum safe size of HC fields }
          BEGIN
           theBufHndl := NewHandle(logEOF);
{ set up the buffer in memory for reading in logEOF characters }
           err := MemError;  { save the result for reporting errors }
           IF (theBufHndl <> NIL) AND (err = noErr) THEN  { continue only if enough memory is available }
            BEGIN
             MoveHHi(theBufHndl);
             HLock(theBufHndl);
             err := FSRead(theRefNum, logEOF, theBufHndl^);
{ read logEOF characters into the location pointed to by theBufHandle^ }
             IF err = noErr THEN      { continue only if the read worked }
              BEGIN   { put a zero byte on the end of the text }
               HUnlock(theBufHndl);
               HNoPurge(theBufHndl);
               zeroByteHndl := NewHandle(2);  { well, really two zero }
               zeroByte := 0;                 { bytes, but who cares? }
               zeroByteHndl^^ := zeroByte;
               HLock(zeroByteHndl);
               err := HandAndHand(zeroByteHndl, theBufHndl);
               HUnlock(zeroByteHndl);
               DisposHandle(zeroByteHndl);
               HLock(theBufHndl);
               IF err = noErr THEN
                BEGIN         { put the text into the field  }
                 SetField(paramPtr, paramPtr^.params[1]^, theBufHndl);
                 IF didSFGet THEN
                  fileName := BuildThePathname(fileName, theVRefNum);
                 passReturnValue(paramPtr, fileName);

      { return the file name as the result }
                END; { if we had no problem appending the zero byte }
              END;  { if err = noErr when reading the file into memory }
             HUnlock(theBufHndl);    { unlock the handle }
             HPurge(theBufHndl);
             DisposHandle(theBufHndl); { and deallocate the memory we used}
            END   { if theBufHndl <> nil }
           ELSE
            passReturnValue(paramPtr, CONCAT('Error ', NumToStr(paramPtr, err)));
          END        { if the file wasn't too big to read in }
         ELSE
          passReturnValue(paramPtr, 'Error (file too big)');
        err := FSClose(theRefNum);            { close the file }
       END;   { if err = noErr in opening the file }
      IF err <> noErr THEN   { if we had an error, report it }
       passReturnValue(ParamPtr, CONCAT('Error ', NumToStr(paramPtr, err)));
     END
    ELSE  { user pushed cancel in the SFGet box--report it }
     passReturnValue(paramPtr, 'Cancel');
   END  { if we got parameters }
  ELSE
   passReturnValue(paramPtr, 'FileToField XCMD 1.2 -- May 16, 1988');
 END;


 PROCEDURE main;
 BEGIN
  FileToField(paramPtr);
 END;

END.